home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / AdjustColors.pdrx < prev    next >
Text File  |  1992-06-22  |  4KB  |  230 lines
  1. /*
  2. @N
  3.  
  4. This Genie will adjust the colors of a selection of objects. 
  5. You may adjust the RGB, CMYK or HSV values of the selection. 
  6. When prompted, input the values for each color you want to adjust.
  7. */
  8. call pdm_AutoUpdate(0)
  9. msg = PDSetup.rexx(2,0)
  10. units =getclip(pds_units)
  11. if msg ~= 1 then exit_msg(msg)
  12. cr = '0a'x
  13.  
  14. obj = pdm_SelFirstObj()
  15. if obj = 0 then exit_msg("Select a group of objects first")
  16.  
  17. type = pdm_SelectFromList("Select Color Model..", 24, 3, 0, "HSV"cr"RGB"cr"YMCK")
  18. if type = '' then exit_msg()
  19.  
  20. if type = "RGB" then
  21. do
  22.  type = 1
  23.  adjfunc = "AdjustRGB"
  24.  form = "Red %"cr"Green %"cr"Blue %"
  25. end
  26. else if type = "YMCK" then
  27. do
  28.  type = 2
  29.  adjfunc = "AdjustYMCK"
  30.  form = "Yellow %"cr"Magenta %"cr"Cyan %"cr"Black %"
  31. end
  32. else
  33. do
  34.  type = 3
  35.  adjfunc = "AdjustHSV"
  36.  form = "Hue %"cr"Saturation %"cr"Value %"
  37. end
  38.  
  39. fills = pdm_SelectFromList("Select attributes to set..", 25, 2, 1, "Line Color"cr"Fill Color")
  40. if fills = '' then exit_msg()
  41.  
  42. if pos("Line", fills) ~= 0 then
  43.  adjline = 1
  44. else
  45.  adjline = 0
  46.  
  47. if pos("Fill", fills) ~= 0 then
  48.  adjfill = 1
  49. else
  50.  adjfill = 0
  51.  
  52. input = pdm_GetForm("Enter offsets..", 8, form)
  53. if input = '' then exit_msg()
  54.  
  55. if type = 1 then
  56. do
  57.  parse var input red '0a'x green '0a'x blue
  58.  
  59.  if red = '' then red = 0
  60.  if green = '' then green = 0
  61.  if blue = '' then blue = 0
  62.  
  63.  if ~(datatype(red, n) & datatype(green, n) & datatype(blue, n)) then
  64.   exit_msg("Invalid Entry")
  65. end
  66. else if type = 2 then
  67. do
  68.  parse var input yellow '0a'x magenta '0a'x cyan '0a'x black
  69.  
  70.  if yellow = '' then yellow = 0
  71.  if magenta = '' then magenta = 0
  72.  if cyan  = '' then cyan = 0
  73.  if black = '' then black = 0
  74.  
  75.  if ~(datatype(black, n) & datatype(magenta, n) & datatype(yellow, n) & datatype(cyan, n)) then
  76.  exit_msg("Invalid Entry")
  77.  
  78. end
  79. else
  80. do
  81.  parse var input hue '0a'x saturation '0a'x value
  82.  
  83.  if hue = '' then hue = 0
  84.  if saturation = '' then saturation = 0
  85.  if value= '' then value = 0
  86.  
  87.  if ~(datatype(hue, n) & datatype(saturation, n) & datatype(value, n)) then
  88.   exit_msg("Invalid Entry")
  89.  
  90. end
  91.  
  92. do while obj ~= 0
  93.  
  94.  if adjline then
  95.  do
  96.   colordata = pdm_GetColorData(pdm_GetLineColor(obj))
  97.   interpret "call pdm_SetLineColor(obj," adjfunc"(colordata))"
  98.  end
  99.  
  100.  if adjfill then
  101.  do
  102.   pattern = pdm_GetFillPattern(obj)
  103.   parse var pattern type '0a'x color1 '0a'x color2 '0a'x a '0a'x b '0a'x c '0a'x d
  104.  
  105.   if type = 0 then break
  106.  
  107.   interpret "color1 = "adjfunc"(pdm_GetColorData('"color1"'))"
  108.  
  109.   if type = 2 then
  110.    interpret "color2 = "adjfunc"(pdm_GetColorData('"color2"'))"
  111.  
  112.   call pdm_SetFillPattern(obj, type, color1, color2, a, b, c, d)
  113.  end
  114.  
  115.  obj = pdm_SelNextObj(obj)
  116. end
  117.  
  118. exit_msg()
  119.  
  120. exit_msg: procedure expose units
  121. do
  122.  parse arg message
  123.  
  124.  if message ~= '' then call pdm_Inform(1,message,)
  125.  call pdm_AutoUpdate(1)
  126.  call pdm_SetUnits(units)
  127.  exit
  128. end
  129.  
  130.  
  131. AdjustRGB: procedure expose red green blue
  132. do
  133.  parse arg colordata
  134.  
  135.  ored = range(15, 0, red * 15 / 100) * 1
  136.  ogreen = range(15, 0, green * 15 / 100) * 1
  137.  oblue = range(15, 0, blue * 15 / 100) * 1
  138.  
  139.  return('UNNAMED RGB 'ored' 'ogreen' 'oblue)
  140. end
  141.  
  142. AdjustYMCK: procedure expose black magenta yellow cyan
  143. do
  144.  parse arg colordata
  145.  
  146.  oblack = range(100, 0, black) * 1
  147.  omagenta= range(100, 0, magenta) * 1
  148.  oyellow = range(100, 0, yellow) * 1
  149.  ocyan = range(100, 0, cyan) * 1
  150.  
  151.  return('UNNAMED YMCK 'oyellow' 'omagenta' 'ocyan' 'oblack)
  152. end
  153.  
  154. AdjustHSV: procedure expose hue saturation value
  155. do
  156.  parse arg colordata
  157.  
  158.  return("UNNAMED RGB " || HSVtoRGB(hue, saturation, value))
  159. end
  160.  
  161. HSVToRGB: procedure
  162. do
  163.  parse arg h, s , v
  164.  
  165.  r = 0
  166.  g = 0
  167.  b = 0
  168.  
  169.  if s = 0  & h = 0 then
  170.  do
  171.   r = v
  172.   g = v
  173.   b = v
  174.  end
  175.  else
  176.  do
  177.   if h = 360 then h = 0
  178.   h = h / 60
  179.   i = floor(h) * 1
  180.   f = h - i
  181.   p = v * (1 - s)
  182.   q = v * ( - (s * f))
  183.   t = v * (1 - (s * (1 - f)))
  184.  
  185.   if i = 0 then
  186.   do
  187.    r = v
  188.    g = t
  189.    b = p
  190.   end
  191.   else if i = 1 then
  192.   do
  193.    r = q
  194.    g = v
  195.    b = p
  196.   end
  197.   else if i = 2 then
  198.   do
  199.    r = p
  200.    g = v
  201.    b = t
  202.   end
  203.   else if i = 3 then
  204.   do
  205.    r = p
  206.    g = q
  207.    b = v
  208.   end
  209.   else if i = 4 then
  210.   do
  211.    r = t
  212.    g = p
  213.    b = v
  214.   end
  215.   else if i = 5 then
  216.   do
  217.    r = v
  218.    g = p
  219.    b = q
  220.   end
  221.  
  222.  end
  223.  
  224.  r = r * 15
  225.  g = g * 15
  226.  b = b * 15
  227.  
  228.  return(r" "g || " " || b)
  229. end
  230.